home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CUSTYPFN.PRG < prev    next >
Encoding:
Text File  |  1993-10-27  |  5.1 KB  |  229 lines
  1. procedure CTEDIT
  2. *       C T E D I T
  3. *       Routine to process Customer Classifications
  4. *    Last change:  MIB  26 Oct 93    5:51 pm
  5.  
  6. parameters TOP, LEFT, NROWS, MODE
  7. * do CTEDIT with TOP, LEFT, NROWS, MODE
  8. private CTFUNC, OLDSCR, WIDTH
  9. public CTFLDS[2], CTHDRS[2]
  10.  
  11. save screen to OLDSCR
  12. select 0
  13. use CUSTTYPE alias CUSTTYPE
  14. WIDTH = 40
  15. CTFUNC = iif(MODE=0,"CTSLCT","CTUPDATE")
  16.  
  17. CTHDRS[1] = "Code"
  18. CTFLDS[1] = "CUSTTYPE"
  19. CTHDRS[2] = "Description"
  20. CTFLDS[2] = "CUSTDESC"
  21. set deleted on
  22. @ TOP, LEFT,TOP+NROWS-1,LEFT+WIDTH box replicate(chr(177),9)
  23. @ TOP+1,LEFT+2 clear to TOP+NROWS-2,LEFT+WIDTH-2
  24. select CUSTTYPE
  25. go top
  26. set color to (COLBRIGHT)
  27. do while .not. GETOUT
  28.     DBEDIT(TOP+1,LEFT+2,TOP+NROWS-2,LEFT+WIDTH-2,CTFLDS,CTFUNC,.t.,CTHDRS,chr(196),chr(179))
  29. enddo
  30.  
  31. GETOUT = .f.
  32. restore screen from OLDSCR
  33. select CUSTTYPE
  34. pack
  35. index on CUSTTYPE to CUSTTYPE
  36. use
  37. return
  38.  
  39. ***********************************************************************
  40.  
  41. function CTSLCT
  42. parameters MODE, FLD_PTR
  43. private CURREC, CURFLD, MEDSTR
  44. currec = recno()
  45. rowno=row()
  46. colno = col()
  47.  
  48. QBKEY = lastkey()
  49. clear typeahead
  50. do case
  51. case MODE<4
  52.     return 1
  53. case QBKEY=27 .or. QBKEY=3
  54.     store "" to MCUSTTYP, MCDESC
  55.     GETOUT = .t.
  56.     return 0
  57. case QBKEY=13
  58.     save screen
  59.     CURFLD = CTFLDS[FLD_PTR]
  60.     MEDSTR = CUSTTYPE->&CURFLD
  61.     set color to (COLFLASH)
  62.     @ ROWNO, COLNO say MEDSTR
  63.     if QBYESNO("Select this Type? (Y/N)")="Y"
  64.         MCUSTTYP = CUSTTYPE->CUSTTYPE
  65.         MCDESC =   CUSTTYPE->CUSTDESC
  66.         GETOUT = .t.
  67.         return 0
  68.     endif
  69.     set color to (COLBRIGHT)
  70.     restore screen
  71. otherwise
  72.     clear typeahead
  73.     do CTPRMT2
  74.     return 1
  75. endcase
  76.  
  77. return 0
  78. ***********************************************************************
  79.  
  80. function CTUPDATE
  81. parameters MODE, FLD_PTR
  82. private SCRBOT, CURREC, GO_REC, CURFLD, MEDSTR
  83. currec = recno()
  84. rowno=row()
  85. colno = col()
  86.  
  87. do CTPRMT1
  88. QBKEY = lastkey()
  89. if QBKEY=27
  90.     GETOUT = .t.
  91. endif
  92.  
  93. do case
  94. case (MODE=2 .or. MODE=3)       && Past top or bottom
  95.     if QBYESNO("Add new Customer Type?")="Y"
  96.         QBRESP = "E"
  97.         go bottom
  98.         append blank
  99.         ROWNO = ROWNO + 1
  100.     else
  101.         do CTPRMT1
  102.         return 1
  103.     endif
  104. case MODE<4
  105.     return 1
  106. case QBKEY=13
  107.     save screen
  108.     CURFLD = CTFLDS[FLD_PTR]
  109.     MEDSTR = CUSTTYPE->&CURFLD
  110.     set color to (COLFLASH)
  111.     @ ROWNO, COLNO say MEDSTR
  112.     QBRESP = iif(QBYESNO("Edit this line?")="Y","E","I")
  113.     set color to (COLBRIGHT)
  114.     restore screen
  115. case QBKEY=-9            && F10
  116.     ACTION = QBPROMPT("Ignore|Edit|Delete|Restore deletions|Quit|","",2)
  117. case QBKEY=27
  118.     QBRESP = "Q"
  119. otherwise
  120.     QBRESP = "E"
  121.     keyboard chr(QBKEY)
  122. endcase
  123.  
  124. CURFLD = CTFLDS[FLD_PTR]
  125. MEDSTR = CUSTTYPE->&CURFLD
  126.  
  127. DO CASE
  128. CASE QBRESP="E"     && Normal Selection by CR
  129.     PICSTR = iif(len(MEDSTR)<10,replicate("!",len(MEDSTR)),replicate("X",len(MEDSTR)))
  130.  
  131.     @ ROWNO, COLNO get MEDSTR picture PICSTR
  132.     do QBREAD with "Enter Information"
  133.     if CHANGED .and. .not. GETOUT
  134.         replace &CURFLD with MEDSTR
  135.     endif
  136. case QBRESP="Q"
  137.     GETOUT = (QBYESNO("Finished editing Customer types?")="Y")
  138. case QBRESP="D"
  139.     save screen
  140.     set color to (COLFLASH)
  141.     @ ROWNO, COLNO say MEDSTR
  142.     if QBYESNO("Delete this Customer type?")="Y"
  143.         delete
  144.     endif
  145.     set color to (COLBRIGHT)
  146.     restore screen
  147.     do CTPRMT1
  148.     skip -1
  149.     skip
  150.     return 2
  151. case QBRESP="R"
  152.     set deleted off
  153.     recall all for deleted()
  154.     set deleted on
  155.     do CTPRMT1
  156.     return 2
  157. otherwise
  158.     GETOUT = .f.
  159. ENDCASE
  160.  
  161. keyboard iif(FLD_PTR=1,chr(4),chr(19))
  162. set color to (COLBRIGHT)
  163.  
  164. return iif(GETOUT,0,1)
  165.  
  166. ***********************************************************************
  167.  
  168. procedure CTPRMT1
  169. *       CTPRMT1
  170. private M
  171. do QBCLMESS
  172. set color to (COLBRIGHT)
  173. M = "Move with "+chr(24)+chr(25)+". Scroll PgUp/PgDn. Exit: ESC."
  174. @ QBMSGLIN,centre(M,80) SAY M
  175. M = [Hit "F10" for Command: Edit, Delete, Restore, Quit]
  176. @ QBMSGLIN+1,centre(M,80) say M
  177.  
  178. return
  179.  
  180. ***********************************************************************
  181.  
  182. procedure CTPRMT2
  183. *       CTPRMT2
  184. private M
  185. do QBCLMESS
  186. set color to (COLBRIGHT)
  187. M = "Move with "+chr(24)+chr(25)+". Scroll PgUp/PgDn. "+ chr(17)+chr(217)+[ to Select, ESC to Abort]
  188. @ QBMSGLIN,CENTRE(M,80) SAY M
  189.  
  190. return
  191.  
  192. ***********************************************************************
  193.  
  194. function VCUSTTYP
  195. *       Return .t if Customer type is present or blank
  196. parameters R, C, BLANKOK
  197. private RETVAL, MEM, VARNAME
  198.  
  199. set softseek off
  200. VARNAME = readvar()
  201. MEM = &VARNAME
  202. if empty(MEM) .and. BLANKOK
  203.     MCUSTTYP = blank(MCUSTTYP)
  204.     MCDESC = blank(MCDESC)
  205.     return .t.
  206. endif
  207.  
  208. select 0
  209. use CUSTTYPE index CUSTTYPE alias CUSTTYPE
  210.  
  211. seek MEM
  212. if eof()
  213.     clear typeahead
  214.     do CTEDIT with 3,37,9,0
  215.     MEM = iif(GETOUT,blank(MEM),MCUSTTYP)
  216. else
  217.     store CUSTTYPE->CUSTTYPE to MEM, MCUSTTYP
  218.     MCDESC = CUSTTYPE->CUSTDESC
  219. endif
  220. set color to (COLBRIGHT)
  221. @ R,C say MEM
  222. set color to (COLNORM)
  223. use
  224.  
  225. return .t.
  226.  
  227. ******************************************************************
  228.  
  229.